home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.11 Nov 91 / Code OOP Sources / ControlObjUnit < prev    next >
Encoding:
Text File  |  1991-02-02  |  9.1 KB  |  329 lines  |  [TEXT/PJMM]
  1. { This Unit contains the objects to implement look-alikes of }
  2. { the standard Macintosh controls: Button, Checkbox, and Radio button }
  3. { The standard controls are much more robust.  These are used }
  4. { as an example for Object Programming within drivers }
  5.  
  6. unit ControlObjUnit;
  7.  
  8. interface
  9.  
  10.     type
  11.     { tControlObj is our base class object for all controls }
  12.         tControlObj = object
  13.                 fControl: ControlHandle;    { the control we are using }
  14.                 procedure mInit (theControl: ControlHandle);    { InitCntl }
  15.                 procedure mFree;    { DispCntl }
  16.                 procedure mDraw (param: LongInt);    { DrawCntl }
  17.                 function mTest (param: LongInt): LongInt;    { TestCntl }
  18.                 procedure mCalcRgn (param: LongInt; message: integer);    { CalcCRgns, calcCntlRgn }
  19.                 procedure mPosition (param: LongInt);    { PosCntl }
  20.                 procedure mCalcThumb (param: LongInt);    { ThumbCntl }
  21.                 function mDrag (param: LongInt): LongInt;    { DragCntl }
  22.                 procedure mAutoTrack (param: LongInt);    { autoTrack }
  23.             end;    { object tControlObj }
  24.  
  25.  
  26.     { our class to handle the basic button codes }
  27.         tButtonMainObj = object(tControlObj)
  28.                 fOldFont, fOldSize: integer;
  29.                 function mTest (param: LongInt): LongInt;
  30.                 override;
  31.                 procedure mCalcRgn (param: LongInt; message: integer);    { CalcCRgns, calcCntlRgn }
  32.                 override;
  33.                 function mGetPartCode: integer;
  34.                 procedure mDrawTitle (hOffset: integer);
  35.                 procedure SetFont;
  36.                 procedure RestoreFont;
  37.             end;    { object tButtonMainObj }
  38.  
  39.     { button routine }
  40.         tPushButObj = object(tButtonMainObj)
  41.                 procedure mDraw (param: LongInt);
  42.                 override;
  43.                 function mGetPartCode: integer;
  44.                 override;
  45.             end;    { object tPushButObj }
  46.  
  47.     { checkBox routine }
  48.         tCheckBoxObj = object(tButtonMainObj)
  49.                 procedure mDraw (param: LongInt);
  50.                 override;
  51.                 procedure mDrawCheckFrame (frame: Rect);
  52.             end;    { object tCheckBoxObj }
  53.  
  54.     { radio button routine }
  55.         tRadioButObj = object(tCheckBoxObj)
  56.                 procedure mDrawCheckFrame (frame: Rect);
  57.                 override;
  58.             end;    { object tRadioButObj }
  59.  
  60. implementation
  61.  
  62. {------------------------------}
  63.     procedure tControlObj.mInit (theControl: ControlHandle);    { InitCntl }
  64.     begin
  65.         fControl := theControl;
  66.     end;    { tControlObj.mInit }
  67.  
  68. {------------------------------}
  69.     procedure tControlObj.mFree;    { DispCntl }
  70.     begin
  71.         Dispose(SELF);
  72.     end;    { tControlObj.mFree }
  73.  
  74. {------------------------------}
  75.     procedure tControlObj.mDraw;    { DrawCntl }
  76.     begin
  77.     end;    { tControlObj.mDraw }
  78.  
  79. {------------------------------}
  80.     function tControlObj.mTest (param: LongInt): LongInt;
  81.     { TestCntl }
  82.     begin
  83.     end;    { tControlObj.mTest }
  84.  
  85. {------------------------------}
  86.     procedure tControlObj.mCalcRgn (param: LongInt; message: integer);
  87.     { CalcCRgns, calcCntlRgn }
  88.     begin
  89.     end;    { tControlObj.mCalcRgn }
  90.  
  91. {------------------------------}
  92.     procedure tControlObj.mPosition (param: LongInt);
  93.     { PosCntl }
  94.     begin
  95.     end;    { tControlObj.mPosition }
  96.  
  97. {------------------------------}
  98.     procedure tControlObj.mCalcThumb (param: LongInt);
  99.     { ThumbCntl }
  100.     begin
  101.     end;    { tControlObj.mCalcThumb }
  102.  
  103. {------------------------------}
  104.     function tControlObj.mDrag (param: LongInt): LongInt;
  105.     { DragCntl }
  106.     begin
  107.     end;    { tControlObj.mDrag }
  108.  
  109. {------------------------------}
  110.     procedure tControlObj.mAutoTrack (param: LongInt);
  111.     { autoTrack }
  112.     begin
  113.     end;    { tControlObj.mAutoTrack }
  114.  
  115. {------------------------------}
  116.     function tButtonMainObj.mTest (param: LongInt): LongInt;
  117.     { Valid as long as its within the contrlRect and the }
  118.     { button isn't dimmed }
  119.         var
  120.             thePoint: Point;
  121.     begin
  122.         mTest := 0;
  123.         thePoint := Point(param);
  124.         if fControl^^.contrlHilite < 254 then
  125.             if PtInRect(thePoint, fControl^^.contrlRect) then
  126.                 mTest := mGetPartCode;
  127.  
  128.     end;    { tButtonMainObj.mTest }
  129.  
  130. {------------------------------}
  131.     procedure tButtonMainObj.mCalcRgn (param: LongInt; message: integer);
  132.     { These controls use their full rectangle as the region }
  133.         var
  134.             TheRgnHdl: Rgnhandle;
  135.     begin
  136.         theRgnHdl := RgnHandle(Param);
  137.         if message = CalcCRgns then
  138.             BitClr(Ptr(theRgnHdl^), 0);    { clear the high bit for 32 bit compatibility }
  139.         RectRgn(theRgnHdl, fControl^^.contrlRect);
  140.     end;    { tButtonMainObj.mCalcRgn }
  141.  
  142. {------------------------------}
  143.     function tButtonMainObj.mGetPartCode: integer;
  144.     { both checkbox and radio button return inCheckBox }
  145.     { We will override for regular button }
  146.     begin
  147.         mGetPartCode := inCheckBox;
  148.     end;    { tButtonMainObj.mGetPartCode }
  149.  
  150. {------------------------------}
  151.     procedure tButtonMainObj.SetFont;
  152.         var
  153.             curPort: GrafPtr;
  154.     begin
  155.         GetPort(curPort);
  156.         fOldFont := curPort^.txFont;
  157.         fOldSize := curPort^.txSize;
  158.         TextFont(0);
  159.         TextSize(12);
  160.     end;    { tButtonMainObj.SetFont}
  161.  
  162. {------------------------------}
  163.     procedure tButtonMainObj.RestoreFont;
  164.     begin
  165.         TextFont(fOldFont);
  166.         TextSize(fOldSize);
  167.     end;    { tButtonMainObj.RestoreFont}
  168.  
  169. {------------------------------}
  170.     procedure tButtonMainObj.mDrawTitle (hOffset: integer);
  171.     { draws and optionally dims the title of the control }
  172.     { parameters are the offset from the rectangle top, left border }
  173.     { Assumes the caller has erased the area }
  174.         var
  175.             dispRect: Rect;
  176.             theRgn: RgnHandle;
  177.             theFontInfo: FontInfo;
  178.             rectHeight, textHeight, vOffset: integer;
  179.             GrayPat: Pattern;
  180.     begin
  181.         SetFont;
  182.         dispRect := fControl^^.contrlRect;
  183.         TheRgn := NewRgn;    { set up a clip }
  184.         GetClip(TheRgn);
  185.         ClipRect(dispRect);
  186.  
  187.         GetFontInfo(theFontInfo);
  188.         rectHeight := (dispRect.bottom - dispRect.top);
  189.         textHeight := theFontInfo.ascent + theFontInfo.leading + theFontInfo.descent;
  190.         vOffset := (rectHeight - textHeight) div 2;
  191.  
  192.         dispRect.left := dispRect.left + hOffset;
  193.         MoveTo(dispRect.Left, dispRect.Top + vOffset + theFontInfo.ascent + theFontInfo.leading);
  194.         DrawString(fControl^^.contrlTitle);
  195.  
  196.         if fControl^^.ContrlHilite = 255 then
  197.             begin    { dim the text }
  198.                 GetIndPattern(GrayPat, 0, 4);    { gray }
  199.                 PenPat(GrayPat);
  200.                 PenMode(PatBic);
  201.                 PaintRect(dispRect);
  202.                 PenNormal;
  203.             end;
  204.  
  205.         SetClip(TheRgn);
  206.         DisposeRgn(theRgn);
  207.         RestoreFont;
  208.     end;    { tButtonMainObj.mDrawTitle }
  209.  
  210. {------------------------------}
  211.  
  212.     procedure tPushButObj.mDraw (param: LongInt);
  213.     { draws the standard button }
  214.         var
  215.             dispRect: Rect;
  216.             hOffset: integer;
  217.     begin
  218.         if (fControl^^.contrlVis <> 0) & (param <> 128) then
  219.             begin
  220.                 dispRect := fControl^^.contrlRect;
  221.                 hOffset := (dispRect.right - dispRect.left - StringWidth(fControl^^.contrlTitle)) div 2;
  222.  
  223.     { now draw everything }
  224.                 EraseRect(dispRect);
  225.  
  226.                 mDrawTitle(hOffset);
  227.  
  228.                 FrameRoundRect(dispRect, 16, 16);    { draw frame }
  229.                 if fControl^^.contrlHilite = InButton then
  230.                     begin    { invert it }
  231.                         InsetRect(dispRect, 1, 1);
  232.                         InvertRoundRect(dispRect, 16, 16);
  233.                     end;
  234.  
  235.             end;    { if fControl^^.contrlVis }
  236.  
  237.     end;    { tPushButObj.mDraw }
  238.  
  239. {------------------------------}
  240.     function tPushButObj.mGetPartCode: integer;
  241.     begin
  242.         mGetPartCode := inButton;
  243.     end;    { tPushButObj.mGetPartCode }
  244.  
  245. {------------------------------}
  246.     procedure tCheckBoxObj.mDraw (param: LongInt);
  247.     { handles both the radio button and checkbox because }
  248.     { they are basically the same }
  249.         const
  250.             cBoxSize = 12;    { size of the checkbox }
  251.             cTextStart = 17;    { Text starts after the box }
  252.         var
  253.             dispRect, boxRect: Rect;
  254.             Gray: Pattern;
  255.             TheFInfo: FontInfo;
  256.             vOffset, vBoxOffset, rectHeight, textHeight: integer;
  257.     begin
  258.         if (fControl^^.contrlVis <> 0) & (param <> 128) then
  259.             begin
  260.                 dispRect := fControl^^.contrlRect;
  261.  
  262.                 vBoxOffset := (dispRect.bottom - dispRect.top - cBoxSize) div 2;
  263.  
  264.     { Draw the checkbox without changing the existing text }
  265.                 BoxRect := dispRect;
  266.                 BoxRect.top := BoxRect.top + vBoxOffset;
  267.                 BoxRect.Bottom := BoxRect.top + cBoxSize;
  268.                 BoxRect.Right := BoxRect.left + cBoxSize;
  269.                 EraseRect(BoxRect);
  270.                 mDrawCheckFrame(BoxRect);
  271.  
  272.     { Draw the text }
  273.                 if (fControl^^.contrlHilite <> inCheckBox) & (fControl^^.contrlTitle <> '') & (Param = 0) then
  274.                     begin    { we have text }
  275.  
  276.                         dispRect.left := dispRect.left + cTextStart;
  277.                         EraseRect(dispRect);    { erase old text }
  278.                         mDrawTitle(cTextStart);
  279.                     end;    { if (Title <> '') }
  280.             end;    { if fControl^^.contrlVis }
  281.  
  282.     end;    { tCheckBoxObj.mDraw }
  283.  
  284. {------------------------------}
  285.     procedure tCheckBoxObj.mDrawCheckFrame (frame: Rect);
  286.     { draws the checkbox image and highlights it if needed }
  287.     begin
  288.         FrameRect(frame);
  289.  
  290.         if fControl^^.contrlValue = 1 then    { draw the checkbox }
  291.             begin
  292.                 MoveTo(frame.left, frame.Top);
  293.                 LineTo(frame.right - 1, frame.bottom - 1);
  294.                 MoveTo(frame.right - 1, frame.top);
  295.                 LineTo(frame.left, frame.bottom - 1);
  296.             end;
  297.  
  298.         if fControl^^.contrlHilite = inCheckBox then    { when drawing hiliting, we don't need to change the text }
  299.             begin
  300.                 InsetRect(frame, 1, 1);
  301.                 FrameRect(frame);
  302.             end;
  303.  
  304.     end;    { tCheckBoxObj.mDrawFrame }
  305.  
  306. {------------------------------}
  307.     procedure tRadioButObj.mDrawCheckFrame (frame: Rect);
  308.     { draws the radio button image and highlights it if needed }
  309.     begin
  310.         FrameOval(frame);
  311.  
  312.         if fControl^^.contrlValue = 1 then    { radio hilite }
  313.             begin
  314.                 InsetRect(frame, 3, 3);
  315.                 PaintOval(frame);    { draw the indicator }
  316.                 InsetRect(frame, -3, -3);
  317.             end;
  318.  
  319.         if fControl^^.contrlHilite = inCheckBox then    { when drawing hiliting, we don't need to change the text }
  320.             begin
  321.                 InsetRect(frame, 1, 1);
  322.                 FrameOval(frame);
  323.             end;
  324.  
  325.     end;    { tRadioButObj.mDrawFrame }
  326.  
  327. {------------------------------}
  328.  
  329. end.    { unit ControlObjUnit }